home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Technotools
/
Technotools (Chestnut CD-ROM)(1993).ISO
/
lang_oth
/
tasking
/
diningph.mod
< prev
next >
Wrap
Text File
|
1986-07-22
|
6KB
|
226 lines
MODULE DiningPhilosophers; (* test for time slicing and locks *)
(*
WARNING: Do not use ctrl-break on this program while it is running.
If you do, DOS may crash!
To stop this program, press any (normal) key and wait for the
program to terminate normally. It may take quite a while
if you are running many tasks.
*)
FROM RandomNumbers IMPORT irand;
FROM Tasks IMPORT NewTask, NextTask;
FROM Locks IMPORT LockType, BusyLock, Lock, Unlock;
FROM DOSlock IMPORT LockDOS, UnlockDOS;
FROM ClockUtilities IMPORT TimeDifference;
FROM TimeDate IMPORT Time, GetTime;
FROM GetPSP IMPORT getarg;
FROM NumberConversion IMPORT CardToString, StringToCard;
FROM ScreenBIOS IMPORT WriteChDTD, ClearScreen, PutCursor, current;
FROM BIOSKeyboard IMPORT Check, Read;
CONST
maxThinkers = 99;
wspSize = 1000; (* work space size (bytes) *)
VAR
numThinkers: CARDINAL;
forks: ARRAY [1 .. maxThinkers] OF LockType;
realLock: LockType; (* IOTRANSFER does not save the state of the 8087 *)
screenLock: LockType;
PROCEDURE thinker; (* main proc for the thinkers processes *)
VAR
id: CARDINAL;
BEGIN
getid(id);
LOOP (* forever *)
msg(id, "think ");
think;
msg(id, "hungry");
getforks(id);
msg(id, "eat ");
eat;
msg(id, "full ");
dropforks(id);
END;
END thinker;
(*
Critical section to assign task id numbers.
*)
VAR
idlock: LockType;
idnums: CARDINAL;
PROCEDURE getid(VAR idnum: CARDINAL);
BEGIN
Lock(idlock);
INC(idnums);
idnum := idnums;
Unlock(idlock);
END getid;
PROCEDURE think;
(* think for 2.0 to 10.0 seconds *)
VAR
thinktime: REAL;
BEGIN
Lock(realLock);
thinktime := FLOAT(rand(800) + 200) / 100.0;
Unlock(realLock);
pause(thinktime);
END think;
PROCEDURE eat;
(* eat for 2.0 to 10.0 seconds *)
VAR
eattime: REAL;
BEGIN
Lock(realLock);
eattime := FLOAT(rand(800) + 200) / 100.0;
Unlock(realLock);
pause(eattime);
END eat;
PROCEDURE getforks(id: CARDINAL);
BEGIN
LOOP
Lock(forks[id]);
(* BusyLock returns TRUE if the lock was already locked *)
IF BusyLock(forks[id MOD numThinkers + 1]) THEN
Unlock(forks[id])
ELSE
EXIT
END;
Lock(forks[id MOD numThinkers + 1]);
IF BusyLock(forks[id]) THEN
Unlock(forks[id MOD numThinkers + 1])
ELSE
EXIT
END;
END;
END getforks;
PROCEDURE dropforks(id: CARDINAL);
BEGIN
Unlock(forks[id]);
Unlock(forks[id MOD numThinkers + 1]);
END dropforks;
PROCEDURE pause(secs: REAL);
VAR
strt, now: Time;
itsdone: BOOLEAN;
BEGIN
GetTimeX(strt);
REPEAT
NextTask;
GetTimeX(now);
Lock(realLock);
itsdone := TimeDifference(strt, now) >= secs;
Unlock(realLock);
UNTIL itsdone;
END pause;
(* random number generator is a non-reentrant critical section too *)
(* think about it! *)
VAR
randlock: LockType;
PROCEDURE rand(lim: CARDINAL): CARDINAL;
VAR
retval: CARDINAL;
BEGIN
Lock(randlock);
retval := irand(lim);
Unlock(randlock);
RETURN retval;
END rand;
(*
MS-DOS is very non-reentrant.
You can't even read the clock and write to the screen at the same time
since both are devices and the device handler handler is non-reentrant
*)
PROCEDURE GetTimeX(VAR t: Time);
BEGIN
LockDOS;
GetTime(t);
UnlockDOS;
END GetTimeX;
PROCEDURE msgn(id: CARDINAL);
VAR
nstr: ARRAY [0 .. 10] OF CHAR;
BEGIN
CardToString(id, nstr, 5);
Lock(screenLock);
PutCursor((id - 1) MOD 25, (id - 1) DIV 25 * 20, 0);
WriteString(nstr);
Unlock(screenLock);
END msgn;
PROCEDURE msg(id: CARDINAL; str: ARRAY OF CHAR);
BEGIN
Lock(screenLock);
PutCursor((id - 1) MOD 25, (id - 1) DIV 25 * 20 + 7, 0);
WriteString(str);
Unlock(screenLock);
END msg;
PROCEDURE WriteString(str: ARRAY OF CHAR);
VAR
i: CARDINAL;
BEGIN
i := 0;
LOOP
IF str[i] = 0c THEN EXIT END;
WriteChDTD(str[i], 7, 0);
INC(i);
IF i > HIGH(str) THEN EXIT END;
END;
END WriteString;
VAR
i: CARDINAL;
ch: CHAR;
str: ARRAY [0 .. 6] OF CHAR;
itsdone: BOOLEAN;
BEGIN (* main initialize *)
ClearScreen(current.attrib);
(* initialize locks by unlocking them *)
Unlock(randlock);
Unlock(idlock);
Unlock(realLock);
Unlock(screenLock);
getarg(1, str);
StringToCard(str, numThinkers, itsdone);
IF NOT itsdone OR (numThinkers < 2) OR (numThinkers > maxThinkers) THEN
numThinkers := 5;
END;
FOR i := 1 TO numThinkers DO (* initialize the forks locks *)
Unlock(forks[i]);
END;
idnums := 0;
FOR i := 1 TO numThinkers DO (* start up the tasks *)
msgn(i);
NewTask(thinker, wspSize);
REPEAT (* optional *)
NextTask;
Lock(idlock);
itsdone := i = idnums;
Unlock(idlock);
UNTIL itsdone;
END;
REPEAT (* Main process loop. Doesn't look like it does much eh? *)
NextTask;
Check(ch, ch, itsdone);
UNTIL itsdone;
(* get DOSlock, termination is a DOS function too! *)
LockDOS;
Read(ch, ch); (* gobble up the pressed key *)
Lock(screenLock);
ClearScreen(current.attrib);
END DiningPhilosophers.